home *** CD-ROM | disk | FTP | other *** search
/ Clickx 115 / Clickx 115.iso / software / tools / windows / tails-i386-0.16.iso / live / filesystem.squashfs / usr / share / perl5 / HTTP / Cookies.pm < prev    next >
Encoding:
Perl POD Document  |  2009-10-06  |  19.8 KB  |  782 lines
  1. package HTTP::Cookies;
  2.  
  3. use strict;
  4. use HTTP::Date qw(str2time parse_date time2str);
  5. use HTTP::Headers::Util qw(_split_header_words join_header_words);
  6.  
  7. use vars qw($VERSION $EPOCH_OFFSET);
  8. $VERSION = "5.833";
  9.  
  10. # Legacy: because "use "HTTP::Cookies" used be the ONLY way
  11. #  to load the class HTTP::Cookies::Netscape.
  12. require HTTP::Cookies::Netscape;
  13.  
  14. $EPOCH_OFFSET = 0;  # difference from Unix epoch
  15. if ($^O eq "MacOS") {
  16.     require Time::Local;
  17.     $EPOCH_OFFSET = Time::Local::timelocal(0,0,0,1,0,70);
  18. }
  19.  
  20. # A HTTP::Cookies object is a hash.  The main attribute is the
  21. # COOKIES 3 level hash:  $self->{COOKIES}{$domain}{$path}{$key}.
  22.  
  23. sub new
  24. {
  25.     my $class = shift;
  26.     my $self = bless {
  27.     COOKIES => {},
  28.     }, $class;
  29.     my %cnf = @_;
  30.     for (keys %cnf) {
  31.     $self->{lc($_)} = $cnf{$_};
  32.     }
  33.     $self->load;
  34.     $self;
  35. }
  36.  
  37.  
  38. sub add_cookie_header
  39. {
  40.     my $self = shift;
  41.     my $request = shift || return;
  42.     my $url = $request->uri;
  43.     my $scheme = $url->scheme;
  44.     unless ($scheme =~ /^https?\z/) {
  45.     return;
  46.     }
  47.  
  48.     my $domain = _host($request, $url);
  49.     $domain = "$domain.local" unless $domain =~ /\./;
  50.     my $secure_request = ($scheme eq "https");
  51.     my $req_path = _url_path($url);
  52.     my $req_port = $url->port;
  53.     my $now = time();
  54.     _normalize_path($req_path) if $req_path =~ /%/;
  55.  
  56.     my @cval;    # cookie values for the "Cookie" header
  57.     my $set_ver;
  58.     my $netscape_only = 0; # An exact domain match applies to any cookie
  59.  
  60.     while ($domain =~ /\./) {
  61.         # Checking $domain for cookies"
  62.     my $cookies = $self->{COOKIES}{$domain};
  63.     next unless $cookies;
  64.     if ($self->{delayload} && defined($cookies->{'//+delayload'})) {
  65.         my $cookie_data = $cookies->{'//+delayload'}{'cookie'};
  66.         delete $self->{COOKIES}{$domain};
  67.         $self->load_cookie($cookie_data->[1]);
  68.         $cookies = $self->{COOKIES}{$domain};
  69.         next unless $cookies;  # should not really happen
  70.     }
  71.  
  72.     # Want to add cookies corresponding to the most specific paths
  73.     # first (i.e. longest path first)
  74.     my $path;
  75.     for $path (sort {length($b) <=> length($a) } keys %$cookies) {
  76.         if (index($req_path, $path) != 0) {
  77.         next;
  78.         }
  79.  
  80.         my($key,$array);
  81.         while (($key,$array) = each %{$cookies->{$path}}) {
  82.         my($version,$val,$port,$path_spec,$secure,$expires) = @$array;
  83.         if ($secure && !$secure_request) {
  84.             next;
  85.         }
  86.         if ($expires && $expires < $now) {
  87.             next;
  88.         }
  89.         if ($port) {
  90.             my $found;
  91.             if ($port =~ s/^_//) {
  92.             # The corresponding Set-Cookie attribute was empty
  93.             $found++ if $port eq $req_port;
  94.             $port = "";
  95.             }
  96.             else {
  97.             my $p;
  98.             for $p (split(/,/, $port)) {
  99.                 $found++, last if $p eq $req_port;
  100.             }
  101.             }
  102.             unless ($found) {
  103.             next;
  104.             }
  105.         }
  106.         if ($version > 0 && $netscape_only) {
  107.             next;
  108.         }
  109.  
  110.         # set version number of cookie header.
  111.             # XXX: What should it be if multiple matching
  112.                 #      Set-Cookie headers have different versions themselves
  113.         if (!$set_ver++) {
  114.             if ($version >= 1) {
  115.             push(@cval, "\$Version=$version");
  116.             }
  117.             elsif (!$self->{hide_cookie2}) {
  118.             $request->header(Cookie2 => '$Version="1"');
  119.             }
  120.         }
  121.  
  122.         # do we need to quote the value
  123.         if ($val =~ /\W/ && $version) {
  124.             $val =~ s/([\\\"])/\\$1/g;
  125.             $val = qq("$val");
  126.         }
  127.  
  128.         # and finally remember this cookie
  129.         push(@cval, "$key=$val");
  130.         if ($version >= 1) {
  131.             push(@cval, qq(\$Path="$path"))     if $path_spec;
  132.             push(@cval, qq(\$Domain="$domain")) if $domain =~ /^\./;
  133.             if (defined $port) {
  134.             my $p = '$Port';
  135.             $p .= qq(="$port") if length $port;
  136.             push(@cval, $p);
  137.             }
  138.         }
  139.  
  140.         }
  141.         }
  142.  
  143.     } continue {
  144.     # Try with a more general domain, alternately stripping
  145.     # leading name components and leading dots.  When this
  146.     # results in a domain with no leading dot, it is for
  147.     # Netscape cookie compatibility only:
  148.     #
  149.     # a.b.c.net    Any cookie
  150.     # .b.c.net    Any cookie
  151.     # b.c.net    Netscape cookie only
  152.     # .c.net    Any cookie
  153.  
  154.     if ($domain =~ s/^\.+//) {
  155.         $netscape_only = 1;
  156.     }
  157.     else {
  158.         $domain =~ s/[^.]*//;
  159.         $netscape_only = 0;
  160.     }
  161.     }
  162.  
  163.     if (@cval) {
  164.     if (my $old = $request->header("Cookie")) {
  165.         unshift(@cval, $old);
  166.     }
  167.     $request->header(Cookie => join("; ", @cval));
  168.     }
  169.  
  170.     $request;
  171. }
  172.  
  173.  
  174. sub extract_cookies
  175. {
  176.     my $self = shift;
  177.     my $response = shift || return;
  178.  
  179.     my @set = _split_header_words($response->_header("Set-Cookie2"));
  180.     my @ns_set = $response->_header("Set-Cookie");
  181.  
  182.     return $response unless @set || @ns_set;  # quick exit
  183.  
  184.     my $request = $response->request;
  185.     my $url = $request->uri;
  186.     my $req_host = _host($request, $url);
  187.     $req_host = "$req_host.local" unless $req_host =~ /\./;
  188.     my $req_port = $url->port;
  189.     my $req_path = _url_path($url);
  190.     _normalize_path($req_path) if $req_path =~ /%/;
  191.  
  192.     if (@ns_set) {
  193.     # The old Netscape cookie format for Set-Cookie
  194.     # http://curl.haxx.se/rfc/cookie_spec.html
  195.     # can for instance contain an unquoted "," in the expires
  196.     # field, so we have to use this ad-hoc parser.
  197.     my $now = time();
  198.  
  199.     # Build a hash of cookies that was present in Set-Cookie2
  200.     # headers.  We need to skip them if we also find them in a
  201.     # Set-Cookie header.
  202.     my %in_set2;
  203.     for (@set) {
  204.         $in_set2{$_->[0]}++;
  205.     }
  206.  
  207.     my $set;
  208.     for $set (@ns_set) {
  209.             $set =~ s/^\s+//;
  210.         my @cur;
  211.         my $param;
  212.         my $expires;
  213.         my $first_param = 1;
  214.         for $param (split(/;\s*/, $set)) {
  215.                 next unless length($param);
  216.         my($k,$v) = split(/\s*=\s*/, $param, 2);
  217.         if (defined $v) {
  218.             $v =~ s/\s+$//;
  219.             #print "$k => $v\n";
  220.         }
  221.         else {
  222.             $k =~ s/\s+$//;
  223.             #print "$k => undef";
  224.         }
  225.         if (!$first_param && lc($k) eq "expires") {
  226.             my $etime = str2time($v);
  227.             if (defined $etime) {
  228.             push(@cur, "Max-Age" => $etime - $now);
  229.             $expires++;
  230.             }
  231.             else {
  232.             # parse_date can deal with years outside the range of time_t,
  233.             my($year, $mon, $day, $hour, $min, $sec, $tz) = parse_date($v);
  234.             if ($year) {
  235.                 my $thisyear = (gmtime)[5] + 1900;
  236.                 if ($year < $thisyear) {
  237.                 push(@cur, "Max-Age" => -1);  # any negative value will do
  238.                 $expires++;
  239.                 }
  240.                 elsif ($year >= $thisyear + 10) {
  241.                 # the date is at least 10 years into the future, just replace
  242.                 # it with something approximate
  243.                 push(@cur, "Max-Age" => 10 * 365 * 24 * 60 * 60);
  244.                 $expires++;
  245.                 }
  246.             }
  247.             }
  248.         }
  249.                 elsif (!$first_param && lc($k) =~ /^(?:version|discard|ns-cookie)/) {
  250.                     # ignore
  251.                 }
  252.         else {
  253.             push(@cur, $k => $v);
  254.         }
  255.         $first_param = 0;
  256.         }
  257.             next unless @cur;
  258.         next if $in_set2{$cur[0]};
  259.  
  260. #        push(@cur, "Port" => $req_port);
  261.         push(@cur, "Discard" => undef) unless $expires;
  262.         push(@cur, "Version" => 0);
  263.         push(@cur, "ns-cookie" => 1);
  264.         push(@set, \@cur);
  265.     }
  266.     }
  267.  
  268.   SET_COOKIE:
  269.     for my $set (@set) {
  270.     next unless @$set >= 2;
  271.  
  272.     my $key = shift @$set;
  273.     my $val = shift @$set;
  274.  
  275.     my %hash;
  276.     while (@$set) {
  277.         my $k = shift @$set;
  278.         my $v = shift @$set;
  279.         my $lc = lc($k);
  280.         # don't loose case distinction for unknown fields
  281.         $k = $lc if $lc =~ /^(?:discard|domain|max-age|
  282.                                     path|port|secure|version)$/x;
  283.         if ($k eq "discard" || $k eq "secure") {
  284.         $v = 1 unless defined $v;
  285.         }
  286.         next if exists $hash{$k};  # only first value is significant
  287.         $hash{$k} = $v;
  288.     };
  289.  
  290.     my %orig_hash = %hash;
  291.     my $version   = delete $hash{version};
  292.     $version = 1 unless defined($version);
  293.     my $discard   = delete $hash{discard};
  294.     my $secure    = delete $hash{secure};
  295.     my $maxage    = delete $hash{'max-age'};
  296.     my $ns_cookie = delete $hash{'ns-cookie'};
  297.  
  298.     # Check domain
  299.     my $domain  = delete $hash{domain};
  300.     $domain = lc($domain) if defined $domain;
  301.     if (defined($domain)
  302.         && $domain ne $req_host && $domain ne ".$req_host") {
  303.         if ($domain !~ /\./ && $domain ne "local") {
  304.         next SET_COOKIE;
  305.         }
  306.         $domain = ".$domain" unless $domain =~ /^\./;
  307.         if ($domain =~ /\.\d+$/) {
  308.         next SET_COOKIE;
  309.         }
  310.         my $len = length($domain);
  311.         unless (substr($req_host, -$len) eq $domain) {
  312.         next SET_COOKIE;
  313.         }
  314.         my $hostpre = substr($req_host, 0, length($req_host) - $len);
  315.         if ($hostpre =~ /\./ && !$ns_cookie) {
  316.         next SET_COOKIE;
  317.         }
  318.     }
  319.     else {
  320.         $domain = $req_host;
  321.     }
  322.  
  323.     my $path = delete $hash{path};
  324.     my $path_spec;
  325.     if (defined $path && $path ne '') {
  326.         $path_spec++;
  327.         _normalize_path($path) if $path =~ /%/;
  328.         if (!$ns_cookie &&
  329.                 substr($req_path, 0, length($path)) ne $path) {
  330.         next SET_COOKIE;
  331.         }
  332.     }
  333.     else {
  334.         $path = $req_path;
  335.         $path =~ s,/[^/]*$,,;
  336.         $path = "/" unless length($path);
  337.     }
  338.  
  339.     my $port;
  340.     if (exists $hash{port}) {
  341.         $port = delete $hash{port};
  342.         if (defined $port) {
  343.         $port =~ s/\s+//g;
  344.         my $found;
  345.         for my $p (split(/,/, $port)) {
  346.             unless ($p =~ /^\d+$/) {
  347.             next SET_COOKIE;
  348.             }
  349.             $found++ if $p eq $req_port;
  350.         }
  351.         unless ($found) {
  352.             next SET_COOKIE;
  353.         }
  354.         }
  355.         else {
  356.         $port = "_$req_port";
  357.         }
  358.     }
  359.     $self->set_cookie($version,$key,$val,$path,$domain,$port,$path_spec,$secure,$maxage,$discard, \%hash)
  360.         if $self->set_cookie_ok(\%orig_hash);
  361.     }
  362.  
  363.     $response;
  364. }
  365.  
  366. sub set_cookie_ok
  367. {
  368.     1;
  369. }
  370.  
  371.  
  372. sub set_cookie
  373. {
  374.     my $self = shift;
  375.     my($version,
  376.        $key, $val, $path, $domain, $port,
  377.        $path_spec, $secure, $maxage, $discard, $rest) = @_;
  378.  
  379.     # path and key can not be empty (key can't start with '$')
  380.     return $self if !defined($path) || $path !~ m,^/, ||
  381.                 !defined($key)  || $key  =~ m,^\$,;
  382.  
  383.     # ensure legal port
  384.     if (defined $port) {
  385.     return $self unless $port =~ /^_?\d+(?:,\d+)*$/;
  386.     }
  387.  
  388.     my $expires;
  389.     if (defined $maxage) {
  390.     if ($maxage <= 0) {
  391.         delete $self->{COOKIES}{$domain}{$path}{$key};
  392.         return $self;
  393.     }
  394.     $expires = time() + $maxage;
  395.     }
  396.     $version = 0 unless defined $version;
  397.  
  398.     my @array = ($version, $val,$port,
  399.          $path_spec,
  400.          $secure, $expires, $discard);
  401.     push(@array, {%$rest}) if defined($rest) && %$rest;
  402.     # trim off undefined values at end
  403.     pop(@array) while !defined $array[-1];
  404.  
  405.     $self->{COOKIES}{$domain}{$path}{$key} = \@array;
  406.     $self;
  407. }
  408.  
  409.  
  410. sub save
  411. {
  412.     my $self = shift;
  413.     my $file = shift || $self->{'file'} || return;
  414.     local(*FILE);
  415.     open(FILE, ">$file") or die "Can't open $file: $!";
  416.     print FILE "#LWP-Cookies-1.0\n";
  417.     print FILE $self->as_string(!$self->{ignore_discard});
  418.     close(FILE);
  419.     1;
  420. }
  421.  
  422.  
  423. sub load
  424. {
  425.     my $self = shift;
  426.     my $file = shift || $self->{'file'} || return;
  427.     local(*FILE, $_);
  428.     local $/ = "\n";  # make sure we got standard record separator
  429.     open(FILE, $file) or return;
  430.     my $magic = <FILE>;
  431.     unless ($magic =~ /^\#LWP-Cookies-(\d+\.\d+)/) {
  432.     warn "$file does not seem to contain cookies";
  433.     return;
  434.     }
  435.     while (<FILE>) {
  436.     next unless s/^Set-Cookie3:\s*//;
  437.     chomp;
  438.     my $cookie;
  439.     for $cookie (_split_header_words($_)) {
  440.         my($key,$val) = splice(@$cookie, 0, 2);
  441.         my %hash;
  442.         while (@$cookie) {
  443.         my $k = shift @$cookie;
  444.         my $v = shift @$cookie;
  445.         $hash{$k} = $v;
  446.         }
  447.         my $version   = delete $hash{version};
  448.         my $path      = delete $hash{path};
  449.         my $domain    = delete $hash{domain};
  450.         my $port      = delete $hash{port};
  451.         my $expires   = str2time(delete $hash{expires});
  452.  
  453.         my $path_spec = exists $hash{path_spec}; delete $hash{path_spec};
  454.         my $secure    = exists $hash{secure};    delete $hash{secure};
  455.         my $discard   = exists $hash{discard};   delete $hash{discard};
  456.  
  457.         my @array =    ($version,$val,$port,
  458.              $path_spec,$secure,$expires,$discard);
  459.         push(@array, \%hash) if %hash;
  460.         $self->{COOKIES}{$domain}{$path}{$key} = \@array;
  461.     }
  462.     }
  463.     close(FILE);
  464.     1;
  465. }
  466.  
  467.  
  468. sub revert
  469. {
  470.     my $self = shift;
  471.     $self->clear->load;
  472.     $self;
  473. }
  474.  
  475.  
  476. sub clear
  477. {
  478.     my $self = shift;
  479.     if (@_ == 0) {
  480.     $self->{COOKIES} = {};
  481.     }
  482.     elsif (@_ == 1) {
  483.     delete $self->{COOKIES}{$_[0]};
  484.     }
  485.     elsif (@_ == 2) {
  486.     delete $self->{COOKIES}{$_[0]}{$_[1]};
  487.     }
  488.     elsif (@_ == 3) {
  489.     delete $self->{COOKIES}{$_[0]}{$_[1]}{$_[2]};
  490.     }
  491.     else {
  492.     require Carp;
  493.         Carp::carp('Usage: $c->clear([domain [,path [,key]]])');
  494.     }
  495.     $self;
  496. }
  497.  
  498.  
  499. sub clear_temporary_cookies
  500. {
  501.     my($self) = @_;
  502.  
  503.     $self->scan(sub {
  504.         if($_[9] or        # "Discard" flag set
  505.            not $_[8]) {    # No expire field?
  506.             $_[8] = -1;            # Set the expire/max_age field
  507.             $self->set_cookie(@_); # Clear the cookie
  508.         }
  509.       });
  510. }
  511.  
  512.  
  513. sub DESTROY
  514. {
  515.     my $self = shift;
  516.     local($., $@, $!, $^E, $?);
  517.     $self->save if $self->{'autosave'};
  518. }
  519.  
  520.  
  521. sub scan
  522. {
  523.     my($self, $cb) = @_;
  524.     my($domain,$path,$key);
  525.     for $domain (sort keys %{$self->{COOKIES}}) {
  526.     for $path (sort keys %{$self->{COOKIES}{$domain}}) {
  527.         for $key (sort keys %{$self->{COOKIES}{$domain}{$path}}) {
  528.         my($version,$val,$port,$path_spec,
  529.            $secure,$expires,$discard,$rest) =
  530.                @{$self->{COOKIES}{$domain}{$path}{$key}};
  531.         $rest = {} unless defined($rest);
  532.         &$cb($version,$key,$val,$path,$domain,$port,
  533.              $path_spec,$secure,$expires,$discard,$rest);
  534.         }
  535.     }
  536.     }
  537. }
  538.  
  539.  
  540. sub as_string
  541. {
  542.     my($self, $skip_discard) = @_;
  543.     my @res;
  544.     $self->scan(sub {
  545.     my($version,$key,$val,$path,$domain,$port,
  546.        $path_spec,$secure,$expires,$discard,$rest) = @_;
  547.     return if $discard && $skip_discard;
  548.     my @h = ($key, $val);
  549.     push(@h, "path", $path);
  550.     push(@h, "domain" => $domain);
  551.     push(@h, "port" => $port) if defined $port;
  552.     push(@h, "path_spec" => undef) if $path_spec;
  553.     push(@h, "secure" => undef) if $secure;
  554.     push(@h, "expires" => HTTP::Date::time2isoz($expires)) if $expires;
  555.     push(@h, "discard" => undef) if $discard;
  556.     my $k;
  557.     for $k (sort keys %$rest) {
  558.         push(@h, $k, $rest->{$k});
  559.     }
  560.     push(@h, "version" => $version);
  561.     push(@res, "Set-Cookie3: " . join_header_words(\@h));
  562.     });
  563.     join("\n", @res, "");
  564. }
  565.  
  566. sub _host
  567. {
  568.     my($request, $url) = @_;
  569.     if (my $h = $request->header("Host")) {
  570.     $h =~ s/:\d+$//;  # might have a port as well
  571.     return lc($h);
  572.     }
  573.     return lc($url->host);
  574. }
  575.  
  576. sub _url_path
  577. {
  578.     my $url = shift;
  579.     my $path;
  580.     if($url->can('epath')) {
  581.        $path = $url->epath;    # URI::URL method
  582.     }
  583.     else {
  584.        $path = $url->path;           # URI::_generic method
  585.     }
  586.     $path = "/" unless length $path;
  587.     $path;
  588. }
  589.  
  590. sub _normalize_path  # so that plain string compare can be used
  591. {
  592.     my $x;
  593.     $_[0] =~ s/%([0-9a-fA-F][0-9a-fA-F])/
  594.              $x = uc($1);
  595.                  $x eq "2F" || $x eq "25" ? "%$x" :
  596.                                             pack("C", hex($x));
  597.               /eg;
  598.     $_[0] =~ s/([\0-\x20\x7f-\xff])/sprintf("%%%02X",ord($1))/eg;
  599. }
  600.  
  601. 1;
  602.  
  603. __END__
  604.  
  605. =head1 NAME
  606.  
  607. HTTP::Cookies - HTTP cookie jars
  608.  
  609. =head1 SYNOPSIS
  610.  
  611.   use HTTP::Cookies;
  612.   $cookie_jar = HTTP::Cookies->new(
  613.     file => "$ENV{'HOME'}/lwp_cookies.dat',
  614.     autosave => 1,
  615.   );
  616.  
  617.   use LWP;
  618.   my $browser = LWP::UserAgent->new;
  619.   $browser->cookie_jar($cookie_jar);
  620.  
  621. Or for an empty and temporary cookie jar:
  622.  
  623.   use LWP;
  624.   my $browser = LWP::UserAgent->new;
  625.   $browser->cookie_jar( {} );
  626.  
  627. =head1 DESCRIPTION
  628.  
  629. This class is for objects that represent a "cookie jar" -- that is, a
  630. database of all the HTTP cookies that a given LWP::UserAgent object
  631. knows about.
  632.  
  633. Cookies are a general mechanism which server side connections can use
  634. to both store and retrieve information on the client side of the
  635. connection.  For more information about cookies refer to
  636. <URL:http://curl.haxx.se/rfc/cookie_spec.html> and
  637. <URL:http://www.cookiecentral.com/>.  This module also implements the
  638. new style cookies described in I<RFC 2965>.
  639. The two variants of cookies are supposed to be able to coexist happily.
  640.  
  641. Instances of the class I<HTTP::Cookies> are able to store a collection
  642. of Set-Cookie2: and Set-Cookie: headers and are able to use this
  643. information to initialize Cookie-headers in I<HTTP::Request> objects.
  644. The state of a I<HTTP::Cookies> object can be saved in and restored from
  645. files.
  646.  
  647. =head1 METHODS
  648.  
  649. The following methods are provided:
  650.  
  651. =over 4
  652.  
  653. =item $cookie_jar = HTTP::Cookies->new
  654.  
  655. The constructor takes hash style parameters.  The following
  656. parameters are recognized:
  657.  
  658.   file:            name of the file to restore cookies from and save cookies to
  659.   autosave:        save during destruction (bool)
  660.   ignore_discard:  save even cookies that are requested to be discarded (bool)
  661.   hide_cookie2:    do not add Cookie2 header to requests
  662.  
  663. Future parameters might include (not yet implemented):
  664.  
  665.   max_cookies               300
  666.   max_cookies_per_domain    20
  667.   max_cookie_size           4096
  668.  
  669.   no_cookies   list of domain names that we never return cookies to
  670.  
  671. =item $cookie_jar->add_cookie_header( $request )
  672.  
  673. The add_cookie_header() method will set the appropriate Cookie:-header
  674. for the I<HTTP::Request> object given as argument.  The $request must
  675. have a valid url attribute before this method is called.
  676.  
  677. =item $cookie_jar->extract_cookies( $response )
  678.  
  679. The extract_cookies() method will look for Set-Cookie: and
  680. Set-Cookie2: headers in the I<HTTP::Response> object passed as
  681. argument.  Any of these headers that are found are used to update
  682. the state of the $cookie_jar.
  683.  
  684. =item $cookie_jar->set_cookie( $version, $key, $val, $path, $domain, $port, $path_spec, $secure, $maxage, $discard, \%rest )
  685.  
  686. The set_cookie() method updates the state of the $cookie_jar.  The
  687. $key, $val, $domain, $port and $path arguments are strings.  The
  688. $path_spec, $secure, $discard arguments are boolean values. The $maxage
  689. value is a number indicating number of seconds that this cookie will
  690. live.  A value <= 0 will delete this cookie.  %rest defines
  691. various other attributes like "Comment" and "CommentURL".
  692.  
  693. =item $cookie_jar->save
  694.  
  695. =item $cookie_jar->save( $file )
  696.  
  697. This method file saves the state of the $cookie_jar to a file.
  698. The state can then be restored later using the load() method.  If a
  699. filename is not specified we will use the name specified during
  700. construction.  If the attribute I<ignore_discard> is set, then we
  701. will even save cookies that are marked to be discarded.
  702.  
  703. The default is to save a sequence of "Set-Cookie3" lines.
  704. "Set-Cookie3" is a proprietary LWP format, not known to be compatible
  705. with any browser.  The I<HTTP::Cookies::Netscape> sub-class can
  706. be used to save in a format compatible with Netscape.
  707.  
  708. =item $cookie_jar->load
  709.  
  710. =item $cookie_jar->load( $file )
  711.  
  712. This method reads the cookies from the file and adds them to the
  713. $cookie_jar.  The file must be in the format written by the save()
  714. method.
  715.  
  716. =item $cookie_jar->revert
  717.  
  718. This method empties the $cookie_jar and re-loads the $cookie_jar
  719. from the last save file.
  720.  
  721. =item $cookie_jar->clear
  722.  
  723. =item $cookie_jar->clear( $domain )
  724.  
  725. =item $cookie_jar->clear( $domain, $path )
  726.  
  727. =item $cookie_jar->clear( $domain, $path, $key )
  728.  
  729. Invoking this method without arguments will empty the whole
  730. $cookie_jar.  If given a single argument only cookies belonging to
  731. that domain will be removed.  If given two arguments, cookies
  732. belonging to the specified path within that domain are removed.  If
  733. given three arguments, then the cookie with the specified key, path
  734. and domain is removed.
  735.  
  736. =item $cookie_jar->clear_temporary_cookies
  737.  
  738. Discard all temporary cookies. Scans for all cookies in the jar
  739. with either no expire field or a true C<discard> flag. To be
  740. called when the user agent shuts down according to RFC 2965.
  741.  
  742. =item $cookie_jar->scan( \&callback )
  743.  
  744. The argument is a subroutine that will be invoked for each cookie
  745. stored in the $cookie_jar.  The subroutine will be invoked with
  746. the following arguments:
  747.  
  748.   0  version
  749.   1  key
  750.   2  val
  751.   3  path
  752.   4  domain
  753.   5  port
  754.   6  path_spec
  755.   7  secure
  756.   8  expires
  757.   9  discard
  758.  10  hash
  759.  
  760. =item $cookie_jar->as_string
  761.  
  762. =item $cookie_jar->as_string( $skip_discardables )
  763.  
  764. The as_string() method will return the state of the $cookie_jar
  765. represented as a sequence of "Set-Cookie3" header lines separated by
  766. "\n".  If $skip_discardables is TRUE, it will not return lines for
  767. cookies with the I<Discard> attribute.
  768.  
  769. =back
  770.  
  771. =head1 SEE ALSO
  772.  
  773. L<HTTP::Cookies::Netscape>, L<HTTP::Cookies::Microsoft>
  774.  
  775. =head1 COPYRIGHT
  776.  
  777. Copyright 1997-2002 Gisle Aas
  778.  
  779. This library is free software; you can redistribute it and/or
  780. modify it under the same terms as Perl itself.
  781.  
  782.